home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / fb386 / ps_graph / ps.bas next >
BASIC Source File  |  1991-10-18  |  24KB  |  811 lines
  1. 1000 '
  2. 1010 ' PostScript(TM) Graph System     F-BASIC386版
  3. 1020 '             Ver. 1.02
  4. 1030 '                 1991.05.17
  5. 1040 '
  6. 1050 '
  7. 1060 '
  8. 1070 'SAVE "PS100.BAS"
  9. 1080 CONSOLE 0,23,2
  10. 1090 ON KEY (1) GOSUB 1120
  11. 1100 KEY (1) ON
  12. 1110 GOTO 1190
  13. 1120 '--------------- PF1 KEY -----------------
  14. 1130 PRINT:COLOR 2
  15. 1140 PRINT "－－－ＰＦ１キーが押されました。終了してもいいですか。（Ｙ／Ｎ）－－－"
  16. 1150 COLOR 7
  17. 1160 SSS$=INPUT$(1):IF SSS$<>"Y" AND SSS$<>"y" THEN RETURN
  18. 1170 KEY (1) OFF
  19. 1180 END
  20. 1190 'START
  21. 1200 F$="PS100.DAT"
  22. 1210 DIM ZD$(6,8,2)
  23. 1220 RESTORE *DEFALT
  24. 1230 FOR I=1 TO 6:FOR J=1 TO 8
  25. 1240 READ A$:ZD$(I,J,1)=A$:READ A$:ZD$(I,J,2)=A$
  26. 1250 NEXT J,I
  27. 1260 READ A$:M_TATE$=A$
  28. 1270 READ A$:M_YOKO$=A$
  29. 1280 READ A$:M_XSE$=A$
  30. 1290 READ A$:M_YSE$=A$
  31. 1300 READ A$:M_HI$=A$
  32. 1310 READ A$:M_OVER$=A$
  33. 1320 *START
  34. 1330 GOSUB *TITLE
  35. 1340 CLOSE
  36. 1350 ON ERROR GOTO *START_ERR
  37. 1360 PRINT
  38. 1370 INPUT "プリンター出力用のファイル名を入力してください。(Default=PS.OUT)";TEM$
  39. 1380 IF TEM$="" THEN TEM$="PS"
  40. 1390 IF LEN(TEM$)>6 THEN TEM$=LEFT$(TEM$,6)
  41. 1400 TEM$=TEM$+SPACE$(6-LEN(TEM$))
  42. 1410 FOUT$=TEM$+".OUT"
  43. 1420 OPEN FOUT$ FOR OUTPUT AS #2
  44. 1430 RESTORE *PSDATA:READ A$
  45. 1440 WHILE A$<>"z":PRINT #2,A$:READ A$:WEND
  46. 1450 CLOSE #2
  47. 1460 PN=1:PF=0
  48. 1470 ON ERROR GOTO 0
  49. 1480 GOTO *MAIN
  50. 1490 *START_ERR
  51. 1500 IF ERR<>64 THEN ON ERROR GOTO 0
  52. 1510 KILL FOUT$
  53. 1520 RESUME
  54. 1530 *MAIN
  55. 1540 CLS
  56. 1550 PRINT "----------- ＭＥＮＵ -----------":PRINT
  57. 1560 PRINT " 1 : 新しくＤＡＴＡを入力する。"
  58. 1570 PRINT " 2 : 既にあるＤＡＴＡを活用する。":PRINT
  59. 1580 INPUT "　番号を入力して下さい。";MENU
  60. 1590 IF MENU=1 THEN *SINKI ELSE IF MENU=2 THEN *KATSUYOU
  61. 1600 GOTO 1540
  62. 1610 '
  63. 1620 *P.END
  64. 1630 PRINT "終了します。"
  65. 1640 KEY (1) OFF
  66. 1650 END
  67. 1660 '
  68. 1670 *SINKI
  69. 1680 OPEN F$ FOR INPUT AS #1
  70. 1690 '番号をカウント --> DNUMBER
  71. 1700 DNUMBER=0
  72. 1710 INPUT #1,A$
  73. 1720 IF A$<>"ZZZ" THEN 1710
  74. 1730 DNUMBER=DNUMBER+1
  75. 1740 IF NOT EOF(1) THEN 1710
  76. 1750 CLOSE #1
  77. 1760 '
  78. 1770 OPEN F$ FOR APPEND AS #1
  79. 1780 IF PF THEN 1850
  80. 1790 '-------------------------------------
  81. 1800 GOSUB *HYOUJI:GOSUB *INP.11
  82. 1810 GOSUB *HYOUJI:GOSUB *INP.31
  83. 1820 GOSUB *HYOUJI:GOSUB *INP.32
  84. 1830 GOSUB *HYOUJI:GOSUB *INP.TATE
  85. 1840 GOSUB *HYOUJI:GOSUB *INP.YOKO
  86. 1850 GOSUB *HYOUJI:GOSUB *INP.XSE
  87. 1860 GOSUB *HYOUJI:GOSUB *INP.YSE
  88. 1870 GOSUB *HYOUJI:GOSUB *INP.HI
  89. 1880 '-------------------------------------
  90. 1890 GOSUB *ICHI
  91. 1900 GOSUB *HYOUJI:P=1:GOSUB *INP.SIKI
  92. 1910 GOSUB *HYOUJI:P=2:GOSUB *INP.SIKI
  93. 1920 GOSUB *HYOUJI:P=5:PP=1:GOSUB *INP.ST
  94. 1930 GOSUB *HYOUJI:P=5:PP=2:GOSUB *INP.ST
  95. 1940 GOSUB *HYOUJI:P=5:PP=3:GOSUB *INP.ST
  96. 1950 GOSUB *HYOUJI:P=6:PP=3:GOSUB *INP.ST
  97. 1960 GOSUB *HYOUJI:P=6:PP=4:GOSUB *INP.ST
  98. 1970 GOSUB *HYOUJI:P=6:PP=5:GOSUB *INP.ST
  99. 1980 GOSUB *MISS.CHECK
  100. 1990 GOSUB *CALCULATE
  101. 2000 GOSUB *KAKIKOMI
  102. 2010 GOTO *INP.OVER
  103. 2020 '------------------------------------
  104. 2030 *SHOW
  105. 2040 OPEN FOUT$ FOR APPEND AS #2
  106. 2050 PRINT #2,"showpage"
  107. 2060 CLOSE #2
  108. 2070 GOSUB *REPRINT
  109. 2080 GOTO *START
  110. 2090 *REPRINT
  111. 2100 OPEN "LPT0:" FOR OUTPUT AS #1
  112. 2110 OPEN FOUT$ FOR INPUT AS #2
  113. 2120 PRINT "ただ今印刷中です。"
  114. 2130 WHILE NOT EOF(2):INPUT #2,P$:PRINT #1,P$:WEND
  115. 2140 CLOSE
  116. 2150 RETURN
  117. 2160 '------------------------------------
  118. 2170 *KATSUYOU
  119. 2180 PRINT
  120. 2190 PRINT "---------- サブ メニュー ----------"
  121. 2200 PRINT " 1 : データ番号を入力する。"
  122. 2210 PRINT " 2 : データ一覧を表示する。"
  123. 2220 PRINT " 3 : メイン メニューに戻る。":PRINT
  124. 2230 INPUT " 番号を入力してください。";TEM
  125. 2240 IF TEM<1 OR TEM>3 THEN CLS:GOTO *KATSUYOU
  126. 2250 IF TEM=3 THEN *MAIN
  127. 2260 IF TEM=2 THEN *KATSU1
  128. 2270 PRINT
  129. 2280 *KA_0
  130. 2290 INPUT "DATA の番号を入力してください。";DNUMBER
  131. 2300 IF DNUMBER=0 THEN *KA_0
  132. 2310 KNUMBER=0
  133. 2320 OPEN F$ FOR INPUT AS #1
  134. 2330 *KA_1
  135. 2340 INPUT #1,A$
  136. 2350 IF A$<>"ZZZ" THEN *KA_1
  137. 2360 IF EOF(1) THEN *KA_ERR
  138. 2370 KNUMBER=KNUMBER+1
  139. 2380 IF KNUMBER<>DNUMBER THEN *KA_1
  140. 2390 PRINT "DATA が見つかりました。"
  141. 2400 GOSUB *IN.FILE
  142. 2410 CLOSE #1
  143. 2420 GOSUB *ICHI
  144. 2430 GOSUB *MISS.CHECK
  145. 2440 GOSUB *CALCULATE
  146. 2450 INPUT "このデータを使用しますか。";TEM$
  147. 2460 IF TEM$="N" OR TEM$="n" THEN *KATSUYOU
  148. 2470 INPUT "この DATA を更新しますか。";TEM$
  149. 2480 IF TEM$="Y" OR TEM$="y" THEN GOSUB *KAKIKOMI ELSE GOSUB *KAKI.PFILE
  150. 2490 GOTO *INP.OVER
  151. 2500 '
  152. 2510 *KA_ERR
  153. 2520 COLOR 2
  154. 2530 PRINT "DATA が見つかりませんでした。"
  155. 2540 COLOR 7
  156. 2550 CLOSE #1
  157. 2560 GOTO *KATSUYOU
  158. 2570 '
  159. 2580 *KATSU1
  160. 2590 CLS
  161. 2600 DNUMBER=0
  162. 2610 OPEN F$ FOR INPUT AS #1
  163. 2620 INPUT #1,A$
  164. 2630 PRINT A$
  165. 2640 PRINT " No.   DATE     TIME       ｺﾒﾝﾄ"
  166. 2650 PRINT "        式(X)        式(Y)"
  167. 2660 *KA1_1
  168. 2670 INPUT #1,A$
  169. 2680 IF A$<>"ZZZ" THEN *KA1_1
  170. 2690 IF EOF(1) THEN *KA1_END
  171. 2700 DNUMBER=DNUMBER+1
  172. 2710 INPUT #1,ZDATE$
  173. 2720 INPUT #1,ZTIME$
  174. 2730 INPUT #1,ZD$(1,1,1)
  175. 2740 INPUT #1,SIKIX$
  176. 2750 INPUT #1,SIKIY$
  177. 2760 PRINT       "-------------------------------------"
  178. 2770 PRINT USING " ###   &      & &      &   &        &";DNUMBER;ZDATE$;ZTIME$;ZD$(1,1,1)
  179. 2780 PRINT USING "        X=&       &  Y=&         &";SIKIX$;SIKIY$
  180. 2790 IF (DNUMBER MOD 4)<>0 THEN *KA1_1
  181. 2800 PRINT "ＳＰＡＣＥ　ＢＡＲで表示続行、その他で中止します。"
  182. 2810 A$=INPUT$(1):IF A$=" " THEN *KA1_1
  183. 2820 BEEP:COLOR 2
  184. 2830 PRINT "データの表示を中止しました。"
  185. 2840 COLOR 7:GOTO *KA1_2
  186. 2850 *KA1_END
  187. 2860 PRINT:PRINT "データは以上です。"
  188. 2870 *KA1_2
  189. 2880 CLOSE #1
  190. 2890 GOTO *KATSUYOU
  191. 2900 '
  192. 2910 '--------------------------------------
  193. 2920 *KAKIKOMI
  194. 2930 IF MENU=1 THEN *KAKI_1
  195. 2940 IF MENU=2 THEN *KAKI_2
  196. 2950 RETURN
  197. 2960 *KAKI_1
  198. 2970 GOSUB *SEND.FILE
  199. 2980 DNUMBER=DNUMBER+1
  200. 2990 GOSUB *KAKI.PFILE
  201. 3000 CLOSE #1
  202. 3010 RETURN
  203. 3020 *KAKI_2
  204. 3030 CLOSE
  205. 3040 OPEN F$ FOR INPUT AS #2
  206. 3050 OPEN "TEMP" FOR OUTPUT AS #1
  207. 3060 TNUMBER=0
  208. 3070 *KAKI_3
  209. 3080 IF EOF(2) THEN *KAKI_5
  210. 3090 INPUT #2,A$
  211. 3100 PRINT #1,A$
  212. 3110 IF A$<>"ZZZ" THEN *KAKI_3
  213. 3120 TNUMBER=TNUMBER+1
  214. 3130 IF TNUMBER<>DNUMBER THEN *KAKI_3
  215. 3140 GOSUB *SEND.FILE
  216. 3150 *KAKI_4
  217. 3160 INPUT #2,A$
  218. 3170 IF A$<>"ZZZ" THEN *KAKI_4 ELSE *KAKI_3
  219. 3180 *KAKI_5
  220. 3190 CLOSE
  221. 3200 KILL F$
  222. 3210 NAME "TEMP" AS F$
  223. 3220 GOSUB *KAKI.PFILE
  224. 3230 RETURN
  225. 3240 '
  226. 3250 *KAKI.PFILE
  227. 3260 OPEN FOUT$ FOR APPEND AS #2
  228. 3270 RESTORE *START.DATA
  229. 3280 *KAP_1
  230. 3290 READ A$
  231. 3300 IF LEFT$(A$,2)<>"zz" THEN *KAP_2
  232. 3310 P=VAL(MID$(A$,3,1)):PP=VAL(RIGHT$(A$,1))
  233. 3320 A$=ZD$(P,PP,1)
  234. 3330 *KAP_2
  235. 3340 IF A$="z" OR A$="Z" THEN CLOSE #2:RETURN
  236. 3350 PRINT #2,A$
  237. 3360 GOTO *KAP_1
  238. 3370 '-----------------------------------------
  239. 3380 *ICHI
  240. 3390 IF PF THEN ZD$(2,1,1)="0":ZD$(2,2,1)="0":RETURN
  241. 3400 IF PN=1 THEN ZD$(2,1,1)="180"
  242. 3410 IF PN=2 THEN ZD$(2,1,1)="270"
  243. 3420 IF PN=3 THEN ZD$(2,1,1)="-270"
  244. 3430 IF PN=4 THEN ZD$(2,1,1)="270"
  245. 3440 IF PN=1 THEN ZD$(2,2,1)="180"
  246. 3450 IF PN=2 THEN ZD$(2,2,1)="0"
  247. 3460 IF PN=3 THEN ZD$(2,2,1)="350"
  248. 3470 IF PN=4 THEN ZD$(2,2,1)="0"
  249. 3480 RETURN
  250. 3490 '入力サブルーチン-------------------------
  251. 3500 *INP.1VAL
  252. 3510 PRINT MES$;" ";:INPUT TEM$
  253. 3520 RETURN
  254. 3530 *INP.2VAL
  255. 3540 PRINT MES$;" ";:INPUT TEM1$,TEM2$
  256. 3550 RETURN
  257. 3560 '----------------------------------------
  258. 3570 *INP.ERR
  259. 3580 PRINT "入力エラーです。入れ直してください。"
  260. 3590 RETURN
  261. 3600 '----------------------------------------
  262. 3610 *INP.11
  263. 3620  MES$=ZD$(1,1,2):GOSUB *INP.1VAL:ZD$(1,1,1)=TEM$
  264. 3630  RETURN
  265. 3640 *INP.31
  266. 3650  MES$=ZD$(3,1,2):GOSUB *INP.1VAL
  267. 3660   IF TEM$=CHR$(13) THEN RETURN
  268. 3670   IF TEM$="y" OR TEM$="Y" THEN ZD$(3,1,1)="true" ELSE ZD$(3,1,1)="false"
  269. 3680  RETURN
  270. 3690 *INP.32
  271. 3700  MES$=ZD$(3,2,2):GOSUB *INP.1VAL
  272. 3710   IF TEM$=CHR$(13) THEN RETURN
  273. 3720   IF TEM$="y" OR TEM$="Y" THEN ZD$(3,2,1)="true" ELSE ZD$(3,2,1)="false"
  274. 3730  RETURN
  275. 3740 *INP.TATE
  276. 3750  MES$=M_TATE$:GOSUB *INP.1VAL:TATE=VAL(TEM$)
  277. 3760   IF TATE<=0 THEN GOSUB *INP.ERR:GOTO *INP.TATE
  278. 3770  RETURN
  279. 3780 *INP.YOKO
  280. 3790  MES$=M_YOKO$:GOSUB *INP.1VAL:YOKO=VAL(TEM$)
  281. 3800   IF YOKO<=0 THEN GOSUB *INP.ERR:GOTO *INP.YOKO
  282. 3810  RETURN
  283. 3820 *INP.XSE
  284. 3830  MES$=M_XSE$:GOSUB *INP.2VAL
  285. 3840   XSTART=VAL(TEM1$):XEND=VAL(TEM2$)
  286. 3850   IF XEND-XSTART<=0 THEN *INP.XSE
  287. 3860  RETURN
  288. 3870 *INP.YSE
  289. 3880  MES$=M_YSE$:GOSUB *INP.2VAL
  290. 3890   YSTART=VAL(TEM1$):YEND=VAL(TEM2$)
  291. 3900   IF YEND-YSTART<=0 THEN *INP.YSE
  292. 3910  RETURN
  293. 3920 *INP.HI
  294. 3930  MES$=M_HI$:GOSUB *INP.1VAL
  295. 3940  IF TEM$="" THEN TEM$=ZD$(4,2,1):RETURN
  296. 3950   IF VAL(TEM$)>0 THEN ZD$(4,2,1)=TEM$ ELSE *INP.HI
  297. 3960  RETURN
  298. 3970 *INP.OVER
  299. 3980  PRINT
  300. 3990  MES$=M_OVER$:GOSUB *INP.1VAL
  301. 4000   IF TEM$="y" OR TEM$="Y" THEN PF=-1 ELSE PF=0
  302. 4010  IF NOT PF THEN ZD$(3,1,1)="false":ZD$(3,2,1)=ZD$(3,1,1)
  303. 4020  IF PF THEN *MAIN
  304. 4030  INPUT "別のグラフを描きますか。";TEM$
  305. 4040   IF TEM$="y" OR TEM$="Y" THEN PN=PN+1 ELSE *SHOW
  306. 4050   IF PN>4 THEN PRINT "もう書けません。印刷します。":GOTO *SHOW
  307. 4060  GOTO *MAIN
  308. 4070 *INP.SIKI ' p=1 --- x   p=2 --- y
  309. 4080  MES$=ZD$(6,P,2):GOSUB *INP.1VAL
  310. 4090  IF P=1 THEN SIKIX$=TEM$
  311. 4100  IF P=2 THEN SIKIY$=TEM$
  312. 4110  RETURN
  313. 4120 *INP.ST
  314. 4130  PRINT ZD$(P,PP,2);"(";ZD$(P,PP,1);")";:INPUT TEM$
  315. 4140   IF TEM$<>"" THEN ZD$(P,PP,1)=TEM$
  316. 4150  RETURN
  317. 4160 '--------------------------------------------
  318. 4170 *CALCULATE
  319. 4180 ZD$(3,4,1)=STR$(YOKO*2.83!)
  320. 4190 ZD$(3,7,1)=STR$(TATE*2.83!)
  321. 4200 HABA_X=YOKO*2.83!/(XEND-XSTART)
  322. 4210 HABA_Y=TATE*2.83!/(YEND-YSTART)
  323. 4220 HABA=HABA_X*(HABA_X<HABA_Y)+HABA_Y*(HABA_X>=HABA_Y)
  324. 4230 ZD$(3,5,1)=STR$(ABS(HABA)):ZD$(3,8,1)=ZD$(3,5,1)
  325. 4240 ZD$(3,3,1)=STR$(XSTART*ABS(HABA))
  326. 4250 ZD$(3,6,1)=STR$(YSTART*ABS(HABA))
  327. 4260 D$=SIKIX$:GOSUB *SPECIAL
  328. 4270 IF NOT ERRFLAG THEN ZD$(6,1,1)=DP$
  329. 4280 D$=SIKIY$:GOSUB *SPECIAL
  330. 4290 IF NOT ERRFLAG THEN ZD$(6,2,1)=DP$
  331. 4300 RETURN
  332. 4310 '--------------------------------------------
  333. 4320 *HYOUJI
  334. 4330 CI=1:CLS
  335. 4340 PRINT "－－－";PN;"個目のグラフです－－－"
  336. 4350 IF MENU=1 THEN *HY_1
  337. 4360 PRINT "このDATAは ";ZDATE$;" ";ZTIME$;" に作成されました。"
  338. 4370 *HY_1
  339. 4380 PRINT CI;" : ";ZD$(1,1,2);" ----- ";ZD$(1,1,1):CI=CI+1
  340. 4390 PRINT CI;" : ";ZD$(3,1,2);" ----- ";ZD$(3,1,1):CI=CI+1
  341. 4400 PRINT CI;" : ";ZD$(3,2,2);" ----- ";ZD$(3,2,1):CI=CI+1
  342. 4410 PRINT CI;" : ";M_TATE$   ;" ----- ";TATE      :CI=CI+1
  343. 4420 PRINT CI;" : ";M_YOKO$   ;" ----- ";YOKO      :CI=CI+1
  344. 4430 PRINT CI;" : ";M_XSE$    ;" ----- ";XSTART;" ,";XEND:CI=CI+1
  345. 4440 PRINT CI;" : ";M_YSE$    ;" ----- ";YSTART;" ,";YEND:CI=CI+1
  346. 4450 PRINT CI;" : ";M_HI$     ;" ----- ";ZD$(4,2,1):CI=CI+1
  347. 4460 PRINT CI;" : ";ZD$(6,1,2);" ----- ";SIKIX$    :CI=CI+1
  348. 4470 PRINT CI;" : ";ZD$(6,2,2);" ----- ";SIKIY$    :CI=CI+1
  349. 4480 PRINT CI;" : ";ZD$(5,1,2);" ----- ";ZD$(5,1,1):CI=CI+1
  350. 4490 PRINT CI;" : ";ZD$(5,2,2);" ----- ";ZD$(5,2,1):CI=CI+1
  351. 4500 PRINT CI;" : ";ZD$(5,3,2);" ----- ";ZD$(5,3,1):CI=CI+1
  352. 4510 PRINT CI;" : ";ZD$(6,3,2);" ----- ";ZD$(6,3,1):CI=CI+1
  353. 4520 PRINT CI;" : ";ZD$(6,4,2);" ----- ";ZD$(6,4,1):CI=CI+1
  354. 4530 PRINT CI;" : ";ZD$(6,5,2);" ----- ";ZD$(6,5,1):CI=CI+1
  355. 4540 PRINT
  356. 4550 RETURN
  357. 4560 *MISS.CHECK
  358. 4570 GOSUB *HYOUJI
  359. 4580 TEM=(VAL(ZD$(5,2,1))-VAL(ZD$(5,1,1)))/VAL(ZD$(5,3,1))
  360. 4590 IF TEM<1000 THEN *MI_1
  361. 4600 COLOR 2
  362. 4610 PRINT "－－－　プロットの回数が多すぎます。　－－－"
  363. 4620 PRINT "－－　パラメーターを調節してください。　－－"
  364. 4630 BEEP:COLOR 7
  365. 4640 *MI_1
  366. 4650 PRINT "これでいいですか？"
  367. 4660 *MI_2
  368. 4670 PRINT "修正する時は番号を、これでいい時は０を入力してください。";
  369. 4680 INPUT CTEM:PRINT
  370. 4690 IF CTEM=0 THEN RETURN
  371. 4700 IF CTEM<0 OR CTEM>16 THEN *MI_2
  372. 4710 IF CTEM=9  THEN P=1 ELSE IF CTEM=10 THEN P=2
  373. 4720 IF CTEM=11 THEN P=5:PP=1
  374. 4730 IF CTEM=12 THEN P=5:PP=2
  375. 4740 IF CTEM=13 THEN P=5:PP=3
  376. 4750 IF CTEM=14 THEN P=6:PP=3
  377. 4760 IF CTEM=15 THEN P=6:PP=4
  378. 4770 IF CTEM=16 THEN P=6:PP=5
  379. 4780 ON CTEM GOSUB *INP.11,*INP.31,*INP.32,*INP.TATE,*INP.YOKO,*INP.XSE,*INP.YSE,*INP.HI,*INP.SIKI,*INP.SIKI
  380. 4790 IF CTEM>10 THEN GOSUB *INP.ST
  381. 4800 GOTO *MISS.CHECK
  382. 4810 '-----------------------------------------------
  383. 4820 *IN.FILE
  384. 4830 INPUT #1,ZDATA$
  385. 4840 INPUT #1,ZTIME$
  386. 4850 INPUT #1,ZD$(1,1,1)
  387. 4860 INPUT #1,SIKIX$
  388. 4870 INPUT #1,SIKIY$
  389. 4880 IF PF THEN INPUT #1,TEM ELSE INPUT #1,TATE
  390. 4890 IF PF THEN INPUT #1,TEM ELSE INPUT #1,YOKO
  391. 4900 INPUT #1,XSTART
  392. 4910 INPUT #1,XEND
  393. 4920 INPUT #1,YSTART
  394. 4930 INPUT #1,YEND
  395. 4940 INPUT #1,ZD$(4,2,1)
  396. 4950 INPUT #1,ZD$(3,1,1)
  397. 4960 INPUT #1,ZD$(3,2,1)
  398. 4970 INPUT #1,ZD$(5,1,1)
  399. 4980 INPUT #1,ZD$(5,2,1)
  400. 4990 INPUT #1,ZD$(5,2,1)
  401. 5000 INPUT #1,ZD$(6,3,1)
  402. 5010 INPUT #1,ZD$(6,4,1)
  403. 5020 INPUT #1,ZD$(6,5,1)
  404. 5030 RETURN
  405. 5040 '----------------------------------------------
  406. 5050 *SEND.FILE
  407. 5060 PRINT #1,ZDATA$
  408. 5070 PRINT #1,ZTIME$
  409. 5080 PRINT #1,ZD$(1,1,1)
  410. 5090 PRINT #1,SIKIX$
  411. 5100 PRINT #1,SIKIY$
  412. 5110 PRINT #1,TATE
  413. 5120 PRINT #1,YOKO
  414. 5130 PRINT #1,XSTART
  415. 5140 PRINT #1,XEND
  416. 5150 PRINT #1,YSTART
  417. 5160 PRINT #1,YEND
  418. 5170 PRINT #1,ZD$(4,2,1)
  419. 5180 PRINT #1,ZD$(3,1,1)
  420. 5190 PRINT #1,ZD$(3,2,1)
  421. 5200 PRINT #1,ZD$(5,1,1)
  422. 5210 PRINT #1,ZD$(5,2,1)
  423. 5220 PRINT #1,ZD$(5,2,1)
  424. 5230 PRINT #1,ZD$(6,3,1)
  425. 5240 PRINT #1,ZD$(6,4,1)
  426. 5250 PRINT #1,ZD$(6,5,1)
  427. 5260 PRINT #1,"ZZZ"
  428. 5270 RETURN
  429. 5280 '----------------------------------------------
  430. 5290 *TITLE
  431. 5300 CLS
  432. 5310 PRINT
  433. 5320 PRINT "ＧＲＡＰＨ作成ツール  PostScript(TM) Level 1 版"
  434. 5330 PRINT
  435. 5340 *TI_1
  436. 5350 PRINT "   番号で選んでください。(１－３）"
  437. 5360 PRINT "     １：ＧＲＡＰＨの作成"
  438. 5370 PRINT "     ２：ユーティリティ"
  439. 5380 PRINT "     ３：プログラムの終了"
  440. 5390 PRINT
  441. 5400 PRINT " （注）初めてこのプログラムを使う時は必ず"
  442. 5410 PRINT "     ユーティリティで＜データファイルの初"
  443. 5420 PRINT "     期化＞を行ってください。"
  444. 5430 INPUT "",TEM$
  445. 5440 IF TEM$="1" THEN RETURN
  446. 5450 IF TEM$="2" THEN *UTILITY
  447. 5460 IF TEM$="3" THEN *P.END
  448. 5470 PRINT "もう一度入力して下さい。"
  449. 5480 GOTO *TI_1
  450. 5490 '
  451. 5500 *UTILITY
  452. 5510 CLS
  453. 5520 PRINT
  454. 5530 PRINT "－－－　ユーティリティ　メニュー　－－－"
  455. 5540 PRINT
  456. 5550 PRINT "    １：データファイルの初期化(ファイル名'PS100.DAT'に固定)"
  457. 5560 PRINT "    ２：すでにあるファイルを印刷する"
  458. 5570 PRINT "    ３：ファイルの内容を一行ずつ見る(デバック用)"
  459. 5580 PRINT "    ４：ファイルの内容を一行毎に変更する(デバック用)"
  460. 5590 PRINT "    ０：メインメニューに戻る"
  461. 5600 PRINT
  462. 5610 INPUT "    番号を入力してください。";TEM
  463. 5620 IF TEM<0 OR TEM>4 THEN *UTILITY
  464. 5630 IF TEM=0 THEN RETURN
  465. 5640 ON TEM GOSUB *UTI1,*UTI2,*UTI3,*UTI4
  466. 5650 GOTO *UTILITY
  467. 5660 'FILE INITIALIZE
  468. 5670 *UTI1
  469. 5680 ON ERROR GOTO *FINIT_ERR
  470. 5690 OPEN F$ FOR OUTPUT AS #1
  471. 5700 PRINT #1,"GRAPH PS DATA FORMAT Version 1.00"
  472. 5710 PRINT #1,"ZZZ"
  473. 5720 CLOSE #1
  474. 5730 ON ERROR GOTO 0
  475. 5740 RETURN
  476. 5750 *FINIT_ERR
  477. 5760 IF ERR<>64 THEN ON ERROR GOTO 0
  478. 5770 KILL F$
  479. 5780 RESUME
  480. 5790 '
  481. 5800 *UTI2
  482. 5810 GOSUB *GET_FOUT_NAME
  483. 5820 IF UTILERR=0 THEN GOSUB *REPRINT
  484. 5830 RETURN
  485. 5840 '
  486. 5850 *UTI3
  487. 5860 PRINT
  488. 5870 PRINT "印刷ファイルの内容を一行ずつ画面に出力します。"
  489. 5880 PRINT "    Q(q)   --- 終了"
  490. 5890 PRINT "    RETURN --- 次行"
  491. 5900 GOSUB *GET_FOUT_NAME
  492. 5910 IF UTILERR=1 THEN RETURN
  493. 5920 OPEN FOUT$ FOR INPUT AS #1
  494. 5930 WHILE NOT EOF(1)
  495. 5940 INPUT #1,A$
  496. 5950 PRINT A$
  497. 5960 A$=INPUT$(1)
  498. 5970 IF A$="Q" OR A$="q" THEN *UTI3_1
  499. 5980 WEND
  500. 5990 *UTI3_1
  501. 6000 CLOSE #1
  502. 6010 RETURN
  503. 6020 '
  504. 6030 *UTI4
  505. 6040 PRINT
  506. 6050 PRINT "印刷ファイルの内容を一行毎に修正できます。"
  507. 6060 PRINT "    文字列     --- その行を｢文字列｣で置き換えます。"
  508. 6070 PRINT "    RETURNのみ --- 次行"
  509. 6080 PRINT "    ｢ZZ｣       --- 中断(ファイルは更新されません。)"
  510. 6090 PRINT "    ｢ZZZ｣      --- 終了(ファイルは更新されます。)"
  511. 6100 GOSUB *GET_FOUT_NAME
  512. 6110 IF UTILERR=1 THEN RETURN
  513. 6120 OPEN FOUT$ FOR INPUT AS #1
  514. 6130 OPEN "PS.X" FOR OUTPUT AS #2
  515. 6140 *UTI4_1
  516. 6150 IF EOF(1) THEN CLOSE:KILL FOUT$:NAME "PS.X" AS FOUT$:RETURN
  517. 6160 INPUT #1,A$:PRINT A$:INPUT "",AA$
  518. 6170 IF AA$="ZZ" THEN CLOSE:KILL "PS.X":RETURN
  519. 6180 IF AA$="ZZZ" THEN *UTI4_2
  520. 6190 IF AA$="" THEN AA$=A$
  521. 6200 PRINT #2,AA$
  522. 6210 GOTO *UTI4_1
  523. 6220 *UTI4_2
  524. 6230 WHILE NOT EOF(1)
  525. 6240   INPUT #1,A$
  526. 6250   PRINT #2,A$
  527. 6260 WEND
  528. 6270 GOTO *UTI4_1
  529. 6280 '
  530. 6290 *GET_FOUT_NAME
  531. 6300 UTILERR=0
  532. 6310 ON ERROR GOTO *UTIERR
  533. 6320 PRINT
  534. 6330 INPUT "プリンター出力用のファイル名を入力してください。";TEM$
  535. 6340 IF TEM$="" THEN TEM$="PS"
  536. 6350 IF LEN(TEM$)>6 THEN TEM$=LEFT$(TEM$,6)
  537. 6360 TEM$=TEM$+SPACE$(6-LEN(TEM$))
  538. 6370 FOUT$=TEM$+".OUT"
  539. 6380 OPEN FOUT$ FOR INPUT AS #1
  540. 6390 *UTIL_RESUME
  541. 6400 CLOSE #1
  542. 6410 ON ERROR GOTO 0
  543. 6420 RETURN
  544. 6430 *UTIERR
  545. 6440 IF ERR<>53 THEN ON ERROR GOTO 0
  546. 6450 BEEP:COLOR 2
  547. 6460 PRINT "入力されたファイルは存在しません。"
  548. 6470 COLOR 7
  549. 6480 PRINT "何かキーを押してください。":TEM$=INPUT$(1)
  550. 6490 UTILERR=1
  551. 6500 RESUME *UTIL_RESUME
  552. 6510 '
  553. 6520 '入力メニュー---------------------
  554. 6530 *DEFALT
  555. 6540 DATA ---,グラフにつける番号,,,,,,,,,,,,,,
  556. 6550 DATA 180,原点位置(x),200,原点位置(y),,,,,,,,,,,,
  557. 6560 DATA false,座標軸表示(Y/N),false,方眼表示(Y/N)
  558. 6570 DATA ---,Ｘ方向始点（原点相対）,---,Ｘ方向長さ,---,Ｘ方向幅
  559. 6580 DATA ---,Ｙ方向始点（原点相対）,---,Ｙ方向長さ,---,Ｙ方向幅
  560. 6590 DATA 1,倍率(x),1,倍率(y),,,,,,,,,,,,
  561. 6600 DATA ---,パラメーター開始値,---,パラメーター終了値
  562. 6610 DATA 0.01,パラメーター増分,,,,,,,,,,
  563. 6620 DATA t,式入力(x),t,式入力(y)
  564. 6630 DATA 1.5,グラフの太さ,0.8,座標軸の太さ,0.1,方眼の太さ,,,,,,
  565. 6640 DATA 縦の長さ
  566. 6650 DATA 横の長さ
  567. 6660 DATA Ｘの範囲（始め，終わり）
  568. 6670 DATA Ｙの範囲（始め，終わり）
  569. 6680 DATA Ｙ軸目盛りの対Ｘ軸比
  570. 6690 DATA グラフを重ねますか。
  571. 6700 *PSDATA '-------------------------------
  572. 6710 DATA /Times-BoldItalic findfont
  573. 6720 DATA 15 scalefont
  574. 6730 DATA setfont
  575. 6740 DATA /inc { 1 index load add def } def
  576. 6750 DATA /pletter { moveto show } def
  577. 6760 DATA /mesh {
  578. 6770 DATA        setlinewidth
  579. 6780 DATA        /y ystart def
  580. 6790 DATA        ylength yinte div floor cvi 1 add
  581. 6800 DATA        {
  582. 6810 DATA         xstart y moveto
  583. 6820 DATA         xlength 0 rlineto
  584. 6830 DATA         /y yinte inc
  585. 6840 DATA        } repeat
  586. 6850 DATA        /x xstart def
  587. 6860 DATA        xlength xinte div floor cvi 1 add
  588. 6870 DATA        {
  589. 6880 DATA         x ystart moveto
  590. 6890 DATA         0 ylength rlineto
  591. 6900 DATA         /x xinte inc
  592. 6910 DATA        } repeat
  593. 6920 DATA        stroke
  594. 6930 DATA       } def
  595. 6940 DATA /axis {
  596. 6950 DATA        setlinewidth
  597. 6960 DATA        xstart 0 moveto 
  598. 6970 DATA        xlength 0 rlineto
  599. 6980 DATA        0 ystart moveto
  600. 6990 DATA        0 ylength rlineto
  601. 7000 DATA        stroke
  602. 7010 DATA       } def
  603. 7020 DATA /unitscale {
  604. 7030 DATA             /yscale exch yinte mul def
  605. 7040 DATA             /xscale exch xinte mul def
  606. 7050 DATA            } def
  607. 7060 DATA /scalexy {
  608. 7070 DATA           /xx x xscale mul def
  609. 7080 DATA           /yy y yscale mul def
  610. 7090 DATA          } def
  611. 7100 DATA /check {
  612. 7110 DATA         xx xstart ge
  613. 7120 DATA         xx xstart xlength add le
  614. 7130 DATA         and
  615. 7140 DATA         yy ystart ge
  616. 7150 DATA         yy ystart ylength add le
  617. 7160 DATA         and and
  618. 7170 DATA        } def
  619. 7180 DATA /exe {
  620. 7190 DATA       {
  621. 7200 DATA        cx cy
  622. 7210 DATA        scalexy
  623. 7220 DATA        check
  624. 7230 DATA        { exit } if
  625. 7240 DATA        /t tinte inc
  626. 7250 DATA       } loop
  627. 7260 DATA       xx yy moveto
  628. 7270 DATA       tend tstart sub tinte div abs floor cvi
  629. 7280 DATA        {
  630. 7290 DATA         /t tinte inc
  631. 7300 DATA         cx cy
  632. 7310 DATA         scalexy
  633. 7320 DATA         check
  634. 7330 DATA         { xx yy lineto } if
  635. 7340 DATA        } repeat
  636. 7350 DATA      } def
  637. 7360 DATA /e 2.71828 def
  638. 7370 DATA z
  639. 7380 *START.DATA
  640. 7390 DATA %
  641. 7400 DATA newpath
  642. 7410 DATA zz21,zz22,translate
  643. 7420 DATA /xstart ,zz33,def
  644. 7430 DATA /xlength,zz34,def
  645. 7440 DATA /xinte  ,zz35,def
  646. 7450 DATA /ystart ,zz36,def
  647. 7460 DATA /ylength,zz37,def
  648. 7470 DATA /yinte   ,zz38,def
  649. 7480 DATA zz31,{,zz64,axis } if
  650. 7490 DATA zz32,{,zz65,mesh } if
  651. 7500 DATA (,zz11,) xstart xlength add 10 add 0 pletter
  652. 7510 DATA zz41,zz42,unitscale
  653. 7520 DATA /tstart,zz51,def
  654. 7530 DATA /tend,zz52,def
  655. 7540 DATA /tinte,zz53,def
  656. 7550 DATA /cx { /x,zz61,def } def
  657. 7560 DATA /cy { /y,zz62,def } def
  658. 7570 DATA /t tstart def
  659. 7580 DATA zz63,setlinewidth
  660. 7590 DATA exe
  661. 7600 DATA stroke
  662. 7610 DATA z
  663. 7620 '----------------------------------------
  664. 7630 *SPECIAL 
  665. 7640 DIM Q$(10,1),QN(10)
  666. 7650 '   12345678901234567890123456789012  1-32
  667. 7660 C$="+-*/^sclet().0123456789inoaqrgxp"
  668. 7670 I=0
  669. 7680 ERRFLAG=0
  670. 7690 DD$=""
  671. 7700 FOR J=1 TO LEN(D$)
  672. 7710 A$=MID$(D$,J,1)
  673. 7720 A$=CHR$(ASC(A$)+&H20*ABS(ASC(A$)>&H40 AND ASC(A$)<&H5B))
  674. 7730 DD$=DD$+A$
  675. 7740 NEXT J
  676. 7750 D$=DD$
  677. 7760 Q$(I,0)=D$
  678. 7770 *SP_LOOP
  679. 7780 GOSUB *TABLE
  680. 7790 TEM$=""
  681. 7800 FOR SI=0 TO I
  682. 7810 TEM$=TEM$+Q$(I,0)
  683. 7820 NEXT SI
  684. 7830 IF TEM$<>"" THEN *SP_LOOP
  685. 7840 *EN 'END
  686. 7850 DP$=Q$(0,1)
  687. 7860 IF DP$="" THEN ERRFLAG=-1
  688. 7870 IF ERRFLAG THEN *EREND
  689. 7880 ERASE Q$,QN
  690. 7890 RETURN
  691. 7900 *EREND
  692. 7910 ERASE Q$,QN
  693. 7920 RETURN
  694. 7930 '
  695. 7940 *TABLE
  696. 7950 GOSUB *GW1
  697. 7960 IF AA>=13 AND AA<=23 THEN *GNUM
  698. 7970 ON AA GOSUB *PLUS,*MINUS,*MULTIPLE,*DIVIDE,*POWER,*SSSR,*SC,*SL,*SE,*TT,*PERO,*PERC
  699. 7980 RETURN
  700. 7990 '
  701. 8000 *GW1
  702. 8010 AA=0:AAN=0
  703. 8020 IF Q$(I,0)="" THEN RETURN
  704. 8030 A$=LEFT$(Q$(I,0),1)
  705. 8040 Q$(I,0)=RIGHT$(Q$(I,0),LEN(Q$(I,0))-1)
  706. 8050 AN$=LEFT$(Q$(I,0),1)
  707. 8060 AA=INSTR(C$,A$)
  708. 8070 AAN=INSTR(C$,AN$)
  709. 8080 IF AA<6 AND AAN<6 THEN *GW1
  710. 8090 IF AA=0 THEN *GW1
  711. 8100 RETURN
  712. 8110 '
  713. 8120 *GNUM
  714. 8130 Q$(I,1)=Q$(I,1)+A$
  715. 8140 WHILE AAN>=13
  716. 8150 GOSUB *GW1
  717. 8160 Q$(I,1)=Q$(I,1)+A$
  718. 8170 WEND
  719. 8180 Q$(I,1)=Q$(I,1)+" "
  720. 8190 RETURN
  721. 8200 '
  722. 8210 *PLUS
  723. 8220 GOSUB *TABLE
  724. 8230 IF AAN<>1 AND AAN<>2 THEN *PLUS
  725. 8240 Q$(I,1)=Q$(I,1)+"add "
  726. 8250 RETURN
  727. 8260 *MINUS
  728. 8270 IF Q$(I,1)="" THEN Q$(I,1)="-":RETURN *TABLE
  729. 8280 *MINUS_1
  730. 8290 GOSUB *TABLE
  731. 8300 IF AAN<>1 AND AAN<>2 THEN *MINUS_1
  732. 8310 Q$(I,1)=Q$(I,1)+"sub "
  733. 8320 RETURN
  734. 8330 *MULTIPLE
  735. 8340 GOSUB *TABLE
  736. 8350 IF AAN=5 THEN *MULTIPLE
  737. 8360 Q$(I,1)=Q$(I,1)+"mul "
  738. 8370 RETURN
  739. 8380 *DIVIDE
  740. 8390 GOSUB *TABLE
  741. 8400 IF AAN=5 THEN *DIVIDE
  742. 8410 Q$(I,1)=Q$(I,1)+"div "
  743. 8420 RETURN
  744. 8430 *POWER
  745. 8440 GOSUB *TABLE
  746. 8450 IF AAN=5 THEN *POWER
  747. 8460 Q$(I,1)=Q$(I,1)+"exp "
  748. 8470 RETURN
  749. 8480 *SSSR
  750. 8490 IF AAN<>24 THEN *SSSR_1 ELSE GOSUB *GW1
  751. 8500 IF AAN<>25 THEN RETURN ELSE GOSUB *GW1
  752. 8510 GOSUB *TABLE
  753. 8520 Q$(I,1)=Q$(I,1)+"sin "
  754. 8530 RETURN
  755. 8540 *SSSR_1
  756. 8550 IF AAN<>28 THEN RETURN ELSE GOSUB *GW1
  757. 8560 IF AAN<>29 THEN RETURN ELSE GOSUB *GW1
  758. 8570 GOSUB *TABLE
  759. 8580 Q$(I,1)=Q$(I,1)+"sqrt "
  760. 8590 RETURN
  761. 8600 *SC
  762. 8610 IF AAN<>26 THEN RETURN ELSE GOSUB *GW1
  763. 8620 IF AAN<>6  THEN RETURN ELSE GOSUB *GW1
  764. 8630 GOSUB *TABLE
  765. 8640 Q$(I,1)=Q$(I,1)+"cos "
  766. 8650 RETURN
  767. 8660 *SL
  768. 8670 IF AAN<>26 THEN RETURN ELSE GOSUB *GW1
  769. 8680 IF AAN<>30 THEN RETURN ELSE GOSUB *GW1
  770. 8690 GOSUB *TABLE
  771. 8700 Q$(I,1)=Q$(I,1)+"ln "
  772. 8710 RETURN
  773. 8720 *SE
  774. 8730 IF AAN<>31 THEN RETURN ELSE GOSUB *GW1
  775. 8740 IF AAN<>32 THEN RETURN ELSE GOSUB *GW1
  776. 8750 GOSUB *TABLE
  777. 8760 Q$(I,1)=Q$(I,1)+"e exch exp "
  778. 8770 *TT
  779. 8780 IF AAN<>27 THEN Q$(I,1)=Q$(I,1)+"t " ELSE GOSUB *GW1
  780. 8790 IF AAN<>25 THEN RETURN ELSE GOSUB *GW1
  781. 8800 GOSUB *TABLE
  782. 8810 Q$(I,1)=Q$(I,1)+"dup sin exch cos div "
  783. 8820 RETURN
  784. 8830 *PERO
  785. 8840 J=1
  786. 8850 *PERO_1
  787. 8860 GOSUB *GW1
  788. 8870 IF AA=11 THEN J=J+1
  789. 8880 IF AA=12 THEN J=J-1
  790. 8890 IF AA=0  THEN *PERO_ERR
  791. 8900 IF J<>0 THEN Q$(I+1,0)=Q$(I+1,0)+A$:GOTO *PERO_1
  792. 8910 QN(I)=AAN
  793. 8920 I=I+1
  794. 8930 *PERO_2
  795. 8940 GOSUB *TABLE
  796. 8950 IF Q$(I,0)<>"" THEN *PERO_2
  797. 8960 I=I-1
  798. 8970 AAN=QN(I)
  799. 8980 Q$(I,1)=Q$(I,1)+Q$(I+1,1)
  800. 8990 Q$(I+1,0)=""
  801. 9000 Q$(I+1,1)=""
  802. 9010 RETURN
  803. 9020 *PERO_ERR 
  804. 9030 PRINT "開きかっこが多すぎます。"
  805. 9040 GOTO *RET_ERR
  806. 9050 *PERC
  807. 9060 PRINT "閉じかっこが多すぎます。"
  808. 9070 *RET_ERR
  809. 9080 ERRFLAG=-1
  810. 9090 RETURN
  811.